home *** CD-ROM | disk | FTP | other *** search
/ Aminet 52 / Aminet 52 (2002)(GTI - Schatztruhe)[!][Dec 2002].iso / Aminet / dev / gg / ncurses-5.3.lha / ncurses-5.3 / Ada95 / samples / sample-curses_demo.adb < prev    next >
Text File  |  2002-10-24  |  6KB  |  144 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                       GNAT ncurses Binding Samples                       --
  4. --                                                                          --
  5. --                            Sample.Curses_Demo                            --
  6. --                                                                          --
  7. --                                 B O D Y                                  --
  8. --                                                                          --
  9. ------------------------------------------------------------------------------
  10. -- Copyright (c) 1998 Free Software Foundation, Inc.                        --
  11. --                                                                          --
  12. -- Permission is hereby granted, free of charge, to any person obtaining a  --
  13. -- copy of this software and associated documentation files (the            --
  14. -- "Software"), to deal in the Software without restriction, including      --
  15. -- without limitation the rights to use, copy, modify, merge, publish,      --
  16. -- distribute, distribute with modifications, sublicense, and/or sell       --
  17. -- copies of the Software, and to permit persons to whom the Software is    --
  18. -- furnished to do so, subject to the following conditions:                 --
  19. --                                                                          --
  20. -- The above copyright notice and this permission notice shall be included  --
  21. -- in all copies or substantial portions of the Software.                   --
  22. --                                                                          --
  23. -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS  --
  24. -- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF               --
  25. -- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.   --
  26. -- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,   --
  27. -- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR    --
  28. -- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR    --
  29. -- THE USE OR OTHER DEALINGS IN THE SOFTWARE.                               --
  30. --                                                                          --
  31. -- Except as contained in this notice, the name(s) of the above copyright   --
  32. -- holders shall not be used in advertising or otherwise to promote the     --
  33. -- sale, use or other dealings in this Software without prior written       --
  34. -- authorization.                                                           --
  35. ------------------------------------------------------------------------------
  36. --  Author:  Juergen Pfeifer, 1996
  37. --  Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en
  38. --  Version Control
  39. --  $Revision: 1.11 $
  40. --  Binding Version 01.00
  41. ------------------------------------------------------------------------------
  42. with Terminal_Interface.Curses; use Terminal_Interface.Curses;
  43. with Terminal_Interface.Curses.Menus; use Terminal_Interface.Curses.Menus;
  44. with Terminal_Interface.Curses.Mouse;  use Terminal_Interface.Curses.Mouse;
  45. with Terminal_Interface.Curses.Panels;  use Terminal_Interface.Curses.Panels;
  46. with Terminal_Interface.Curses.Panels.User_Data;
  47.  
  48. with Sample.Manifest; use Sample.Manifest;
  49. with Sample.Helpers; use Sample.Helpers;
  50. with Sample.Function_Key_Setting; use Sample.Function_Key_Setting;
  51.  
  52. with Sample.Explanation; use Sample.Explanation;
  53.  
  54. with Sample.Menu_Demo.Handler;
  55. with Sample.Curses_Demo.Mouse;
  56. with Sample.Curses_Demo.Attributes;
  57.  
  58. package body Sample.Curses_Demo is
  59.  
  60.    type User_Data is new Integer;
  61.    type User_Data_Access is access all User_Data;
  62.    package PUD is new Panels.User_Data (User_Data, User_Data_Access);
  63.    --  We use above instantiation of the generic User_Data package to
  64.    --  demonstrate and test the use of the user data maechanism.
  65.  
  66.    procedure Demo
  67.    is
  68.       function My_Driver (M : Menu;
  69.                           K : Key_Code;
  70.                           Pan : Panel) return Boolean;
  71.       package Mh is new Sample.Menu_Demo.Handler (My_Driver);
  72.  
  73.       Itm : Item_Array_Access := new Item_Array'
  74.         (New_Item ("Attributes Demo"),
  75.          New_Item ("Mouse Demo"),
  76.          Null_Item);
  77.       M  : Menu := New_Menu (Itm);
  78.       U1 : User_Data_Access := new User_Data'(4711);
  79.       U2 : User_Data_Access;
  80.  
  81.       function My_Driver (M : Menu;
  82.                           K : Key_Code;
  83.                           Pan : Panel) return Boolean
  84.       is
  85.          Idx : constant Positive := Get_Index (Current (M));
  86.          Result : Boolean := False;
  87.       begin
  88.          PUD.Set_User_Data (Pan, U1); --  set some user data, just for fun
  89.          if K in User_Key_Code'Range then
  90.             if K = QUIT then
  91.                Result := True;
  92.             elsif K = SELECT_ITEM then
  93.                if Idx in Itm'Range then
  94.                   Hide (Pan);
  95.                   Update_Panels;
  96.                end if;
  97.                case Idx is
  98.                   when 1 => Sample.Curses_Demo.Attributes.Demo;
  99.                   when 2 => Sample.Curses_Demo.Mouse.Demo;
  100.                   when others => Not_Implemented;
  101.                end case;
  102.                if Idx in Itm'Range then
  103.                   Top (Pan);
  104.                   Show (Pan);
  105.                   Update_Panels;
  106.                   Update_Screen;
  107.                end if;
  108.             end if;
  109.          end if;
  110.          PUD.Get_User_Data (Pan, U2); --  get the user data
  111.          pragma Assert (U1.all = U2.all and then U1 = U2);
  112.          return Result;
  113.       end My_Driver;
  114.  
  115.    begin
  116.  
  117.       if (1 + Item_Count (M)) /= Itm'Length then
  118.          raise Constraint_Error;
  119.       end if;
  120.  
  121.       if not Has_Mouse then
  122.          declare
  123.             O : Item_Option_Set;
  124.          begin
  125.             Get_Options (Itm (2), O);
  126.             O.Selectable := False;
  127.             Set_Options (Itm (2), O);
  128.          end;
  129.       end if;
  130.  
  131.       Push_Environment ("CURSES00");
  132.       Notepad ("CURSES-PAD00");
  133.       Default_Labels;
  134.       Refresh_Soft_Label_Keys_Without_Update;
  135.  
  136.       Mh.Drive_Me (M, " Demo ");
  137.       Pop_Environment;
  138.  
  139.       Delete (M);
  140.       Free (Itm, True);
  141.    end Demo;
  142.  
  143. end Sample.Curses_Demo;
  144.